home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
oop_tp55.zip
/
TRIGL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-04-16
|
8KB
|
296 lines
unit Trigl;
interface
uses ListObj,CRT;
const
MaxGen = 13;
var
PosStats : array[0..MaxGen] of longint;
type
String15 = string[15];
MoveArray = array[1..3] of integer;
MoveDirection = (no_move, down, up);
MoveFunc = function( i : integer) : MoveDirection;
MoveFuncPtr = ^MoveFunc;
const
MaxNumMove = 18;
LegalMoves : array[1..18] of MoveArray =
( (1,2,4), (1,3,6), (2,4,7), (2,5,9),
(3,5,8), (3,6,10), (4,5,6), (4,7,11),
(4,8,13), (5,8,12), (5,9,14), (6,9,13),
(6,10,15), (7,8,9), (8,9,10), (11,12,13),
(12,13,14), (13,14,15) );
type
{ this would be a great place to have multiple inheritance, what we
really need is an object that acts like both a list and a node }
{ best we can do, then is to have a node with a constituent list
property}
Triangle = object( Node )
position : String15;
Offspring : List;
Generation : integer;
constructor Init( APosition : String15; Gen : integer );
destructor Done;
procedure ShowPosition;
procedure ShowWin;
procedure ShowStats;
function Heuristic : boolean; virtual;
function FindWin : boolean;
function FindChildren : boolean;
function ValidMove( AMove : integer ) : MoveDirection;
procedure MovePeg( MoveNumber : integer;
Direction : MoveDirection;
var NewPosition : String15 );
procedure GenChild( NewPosition : string15 ); virtual;
function CheckForWin : boolean;
end;
type
TrianglePtr = ^Triangle;
procedure Step;
procedure InitStats;
procedure DisplayPosition( Position : String15; x, y : integer);
implementation
procedure Step;
var
Dummy : char;
begin
Dummy := ReadKey;
end;
destructor Triangle.Done;
begin
FreeMem( @Offspring, sizeof(Offspring) );
end;
procedure Triangle.ShowWin;
var
pTriangle : TrianglePtr;
i : integer;
begin
if Generation = 0 then
begin
ShowPosition;
Step;
end;
if Offspring.Head <> nil then
begin
Offspring.Cursor := Offspring.Head;
pTriangle := Offspring.GetCursor;;
pTriangle^.ShowPosition;
Step;
pTriangle^.ShowWin;
end;
end;
procedure Triangle.ShowStats;
var
i : integer;
t : longint;
begin
ClrScr;
t := 0;
for i := 0 to MaxGen do
begin
writeln('Number of generation ', i:2, ' positions: ', PosStats[i]);
t := t + PosStats[i];
end;
writeln;
writeln('Total number of positions examined: ', t );
Step;
end;
function Triangle.FindWin : boolean;
var
pTriangle : TrianglePtr;
WinFlag : boolean;
begin
if FindChildren = true then
begin
WinFlag := false;
OffSpring.Cursor := OffSpring.Head; { point at head }
while (Offspring.FindNextObject = true) and (WinFlag = false) do
begin
pTriangle := OffSpring.GetCursor; { copy head }
WinFlag := pTriangle^.FindWin; { find if it leads to win }
if WinFlag = false then { if it doesn't }
begin
pTriangle := Offspring.PopFirst;
Dispose( pTriangle, Done );
end;
end;
FindWin := WinFlag;
end
else
begin
if CheckForWin = true then { This means that the Self triangle is
a winner! }
begin
writeln( 'I found a win!');
ShowPosition;
FindWin := true;
end
else
begin
FindWin := false;
end;
end;
end;
{ a triangle node has the ability to find its own children
if it successfully finds its children, the function returns true.
if a triangle has no children, then we check to see if a winning
position has been found. }
function Triangle.FindChildren : boolean;
var
i : integer;
vflag : MoveDirection;
NewPosition : String15;
begin
FindChildren := false;
if Heuristic = true then
for i := 1 to MaxNumMove do
begin
vflag := ValidMove(i);
if vflag <> no_move then
begin
Inc(PosStats[Generation+1]);
MovePeg( i, vflag, NewPosition );
GenChild(NewPosition);
FindChildren := true;
end
end;
end;
function Triangle.Heuristic : boolean;
begin
Heuristic := true
end;
{ a triangle knows whether a particular type of move is valid for
its position. the function returns NO_MOVE if no move is
possible, UP if a peg can jump from the 3 position to the 1 position
(as described in the move array), or DOWN if a peg can jump from
the 1 to the 3 position. }
function Triangle.ValidMove( AMove : integer ) : MoveDirection;
begin
if (Position[ LegalMoves[AMove,1] ] = 'X') and
(Position[ LegalMoves[AMove,2] ] = 'X') and
(Position[ LegalMoves[AMove,3] ] = 'O') then
ValidMove := down
else
if (Position[ LegalMoves[AMove,1] ] = 'O') and
(Position[ LegalMoves[AMove,2] ] = 'X') and
(Position[ LegalMoves[AMove,3] ] = 'X') then
ValidMove := up
else
ValidMove := no_move;
end;
{ given a type of move and a direction (UP or DOWN), a triangle knows
how to reflect the move in the Position array, and how to create a
new Triangle object whose position is the new position, and to
attach the new Triangle object as a member of Offspring list }
procedure Triangle.MovePeg( MoveNumber : integer; Direction : MoveDirection;
var NewPosition : String15 );
var
pNewTriangle : TrianglePtr;
c : char;
begin
NewPosition := Position;
NewPosition[ LegalMoves[MoveNumber, 2] ] := 'O';
if Direction = down then
begin
NewPosition[ LegalMoves[MoveNumber, 1] ] := 'O';
NewPosition[ LegalMoves[MoveNumber, 3] ] := 'X';
end
else
begin
NewPosition[ LegalMoves[MoveNumber, 3] ] := 'O';
NewPosition[ LegalMoves[MoveNumber, 1] ] := 'X';
end;
end;
procedure Triangle.GenChild( NewPosition : string15 );
var
pNewTriangle : TrianglePtr;
begin
New( pNewTriangle, Init( NewPosition, Succ(Generation) ) );
{ if you really want to speed things up, comment out the next line }
pNewTriangle^.ShowPosition;
Offspring.Prepend( pNewTriangle );
Offspring.Cursor := OffSpring.Head;
end;
constructor Triangle.Init( APosition : String15; Gen : integer );
begin
Position := APosition;
Offspring.Init;
Node.Init( SizeOf( Self ) );
Generation := Gen;
end;
procedure DisplayPosition( Position : String15; x, y : integer);
begin
gotoXY(x,y);
writeln( ' ', Position[1]);
gotoXY(x,y+2);
writeln( ' ', Position[2], ' ', Position[3] );
gotoXY(x,y+4);
writeln( ' ', Position[4], ' ', Position[5],
' ', Position[6]);
gotoXY(x,y+6);
writeln( ' ', Position[7], ' ', Position[8],
' ', Position[9], ' ', Position[10] );
gotoXY(x,y+8);
writeln( ' ', Position[11], ' ', Position[12], ' ',
Position[13], ' ', Position[14], ' ', Position[15] );
end;
procedure Triangle.ShowPosition;
begin
gotoXY(16,10);
writeln( 'Generation: ' , Generation:2 );
DisplayPosition( Position, 16, 12 );
end;
function Triangle.CheckForWin;
var
FirstX : integer;
SubS : string;
begin
FirstX := Pos( 'X', Position );
SubS := Copy( Position, (FirstX+1), 255 );
if Pos( 'X', SubS ) = 0 then
CheckForWin := true
else
CheckForWin := false;
end;
procedure InitStats;
var
i : integer;
begin
PosStats[0] := 1;
for i := 1 to MaxGen do
PosStats[i] := 0;
end;
begin
InitStats;
end.